home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-1 / common.sit / dlrgint.c / dlrgint.c
Encoding:
C/C++ Source or Header  |  1992-09-19  |  3.8 KB  |  253 lines  |  [TEXT/MPS ]
  1. /*
  2.  * dlrgint.c - versions of "large integer" routines for compiled programs
  3.  *   that do not support large integers.
  4.  */
  5. #define COMPILER 1
  6. #include "::h:rt.h"
  7.  
  8. /*
  9.  *****************************************************************
  10.  *
  11.  * Routines in the first set are only called when large integers
  12.  *  exist and thus these versions will never be called. They need
  13.  *  only have the correct signature and compile without error.
  14.  */
  15.  
  16. /*
  17.  *  bignum -> file 
  18.  */
  19. novalue bigprint(f, da)
  20. FILE *f;
  21. dptr da;
  22. {
  23. }
  24.  
  25. /*
  26.  *  bignum -> real
  27.  */
  28. double bigtoreal(da)
  29. dptr da;
  30.    {
  31.    return 0.0;
  32.    }
  33.  
  34. /*
  35.  *  bignum -> string
  36.  */
  37. int bigtos(da, dx)
  38. dptr da, dx;
  39.    {
  40.    return 0;
  41.    }
  42.  
  43. /*
  44.  *  da -> dx
  45.  */
  46. int cpbignum(da, dx)
  47. dptr da, dx;
  48.    {
  49.    return 0;
  50.    }
  51.  
  52. /*
  53.  *  da / db -> dx
  54.  */
  55. int bigdiv(da, db, dx)
  56. dptr da, db, dx;
  57.    {
  58.    return 0;
  59.    }
  60.  
  61. /*
  62.  *  da % db -> dx
  63.  */
  64. int bigmod(da, db, dx)
  65. dptr da, db, dx;
  66.    {
  67.    return 0;
  68.    }
  69.  
  70. /*
  71.  *  iand(da, db) -> dx
  72.  */
  73. int bigand(da, db, dx)
  74. dptr da, db, dx;
  75.    {
  76.    return 0;
  77.    }
  78.  
  79. /*
  80.  *  ior(da, db) -> dx
  81.  */
  82. int bigor(da, db, dx)
  83. dptr da, db, dx;
  84.    {
  85.    return 0;
  86.    }
  87.  
  88. /*
  89.  *  xor(da, db) -> dx
  90.  */
  91. int bigxor(da, db, dx)
  92. dptr da, db, dx;
  93.    {
  94.    return 0;
  95.    }
  96.  
  97. /*
  98.  *  negative if da < db
  99.  *  zero if da == db
  100.  *  positive if da > db
  101.  */
  102. word bigcmp(da, db)
  103. dptr da, db;
  104.    {
  105.    return (word)0;
  106.    }
  107.  
  108. /*
  109.  *  ?da -> dx
  110.  */  
  111. int bigrand(da, dx)
  112. dptr da, dx;
  113.    {
  114.    return 0;
  115.    }
  116.  
  117. /*
  118.  *************************************************************
  119.  *
  120.  * The following routines are called when overflow has occurred
  121.  *   during ordinary arithmetic.
  122.  */
  123.  
  124. /*
  125.  *  da + db -> dx
  126.  */
  127. int bigadd(da, db, dx)
  128. dptr da, db;
  129. dptr dx;
  130.    {
  131.    t_errornumber = 203;
  132.    t_errorvalue = nulldesc;
  133.    t_have_val = 0;
  134.    return Error;
  135.    }
  136.  
  137. /*
  138.  *  da * db -> dx
  139.  */
  140. int bigmul(da, db, dx)
  141. dptr da, db, dx;
  142.    {
  143.    t_errornumber = 203;
  144.    t_errorvalue = nulldesc;
  145.    t_have_val = 0;
  146.    return Error;
  147.    }
  148.  
  149. /*
  150.  *  -i -> dx
  151.  */
  152. int bigneg(da, dx)
  153. dptr da, dx;
  154.    {
  155.    t_errornumber = 203;
  156.    t_errorvalue = nulldesc;
  157.    t_have_val = 0;
  158.    return Error;
  159.    }
  160.  
  161. /*
  162.  *  da - db -> dx
  163.  */ 
  164. int bigsub(da, db, dx)
  165. dptr da, db, dx;
  166.    {
  167.    t_errornumber = 203;
  168.    t_errorvalue = nulldesc;
  169.    t_have_val = 0;
  170.    return Error;
  171.    }
  172.  
  173. /*
  174.  * ********************************************************
  175.  *
  176.  * The remaining routines each requires different handling.
  177.  */
  178.  
  179. /*
  180.  *  real -> bignum
  181.  */
  182. int realtobig(da, dx)
  183. dptr da, dx;
  184.    {
  185.    return Failed;  /* conversion cannot be done */
  186.    }
  187.  
  188. /*
  189.  *  da ^ db -> dx
  190.  */
  191. int bigpow(da, db, dx)
  192. dptr da, db, dx;
  193.    {
  194.    C_integer r;
  195.    extern int over_flow;
  196.  
  197.    /*
  198.     * Just do ordinary interger exponentiation and check for overflow.
  199.     */
  200.    r = iipow(IntVal(*da), IntVal(*db));
  201.    if (over_flow) {
  202.       k_errornumber = 203;
  203.       k_errortext = "";
  204.       k_errorvalue = nulldesc;
  205.       have_errval = 0;
  206.       return Error;
  207.       }
  208.    MakeInt(r, dx)
  209.    return Succeeded;
  210.    }
  211.  
  212. /*
  213.  *  string -> bignum 
  214.  */
  215. word bigradix(sign, r, s, end_s, result)
  216. int sign;                      /* '-' or not */
  217. int r;                          /* radix 2 .. 36 */
  218. char *s, *end_s;                        /* input string */
  219. union numeric *result;          /* output T_Integer or T_Lrgint */
  220.    {
  221.    /*
  222.     * Just do string to ordinary integer.
  223.     */
  224.    return radix(sign, r, s, end_s, result);
  225.    }
  226.  
  227. /*
  228.  *  bigshift(da, db) -> dx
  229.  */
  230. int bigshift(da, db, dx)
  231. dptr da, db, dx;
  232.    {
  233.    uword ci;                  /* shift in 0s, even if negative */
  234.    C_integer cj;
  235.  
  236.    /*
  237.     * Do an ordinary shift - note that db is always positive when this
  238.     *   routine is called.
  239.     */
  240.    ci = (uword)IntVal(*da);
  241.    cj = IntVal(*db);
  242.    /*
  243.     * Check for a shift of WordSize or greater; return an explicit 0 because
  244.     *  this is beyond C's defined behavior.  Otherwise shift as requested.
  245.     */
  246.    if (cj >= WordBits)
  247.       ci = 0;
  248.    else
  249.       ci <<= cj;
  250.    MakeInt(ci, dx)
  251.    return Succeeded;
  252.    }
  253.